home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / dbase / pslib.zip / PS_LIB.PRG next >
Text File  |  1991-02-26  |  11KB  |  294 lines
  1. * Program........: PS_Lib.PRG
  2. * Version........: 0.2
  3. * Author.........: Richard Elliott, Ferret Software
  4. * Copyright......: Copyright 1991, Ferret Software, All Rights reserved
  5. * Purpose........: Postscript Procedure Library
  6. * Language.......: Foxpro 1.02
  7. * Usage..........: SET PROCEDURE TO PS_Lib
  8.  
  9. * ---------------------------------------------------------
  10.  
  11. PROCEDURE Init_Print             && Do first to set system variables
  12. PUBLIC TMargin, LMargin, xpos, ypos, crlf, ejectit, psfooter
  13.  
  14.    TMargin =  1       && default margins in inches, change as needed
  15.    LMargin =  1
  16.    xpos    =  0
  17.    ypos    = 11
  18.    crlf    = CHR(13) + CHR(10)         && Used to make PS code readable in file
  19.    ejectit = "showpage" + crlf         && Use as:  ??? ejectit  - For new pages
  20.    psfooter = "%!END" + crlf + ""     && Clears up the end
  21.  
  22.    ??? "%!PS-Adobe-1.0" + crlf            && Standard PS header info
  23.    ??? "%%Title: PS_LIB output" + crlf
  24.    ??? "%%Creator: Ferret Software's PS Library" + crlf
  25.    ??? "%%CreationDate: " + DTOC(DATE()) + crlf
  26.    ??? "%%EndComments" + crlf + crlf
  27.  
  28. RETURN
  29.  
  30. * ---------------------------------------------------------
  31.  
  32. FUNCTION Orient
  33. PARAMETERS _orient
  34.  
  35.    ** Use as: ??? ORIENT(orientation)
  36.  
  37.    DO CASE
  38.       CASE UPPER( _orient ) = "PORT"
  39.          _temp = "0 0 translate 0 rotate" + crlf
  40.       CASE UPPER( _orient ) = "LAND"
  41.          _temp = "11 0 translate 90 rotate" + crlf
  42.       OTHERWISE
  43.          _temp = ''
  44.    ENDCASE
  45.  
  46. RETURN _temp
  47.  
  48. * ---------------------------------------------------------
  49.  
  50. FUNCTION Lpi
  51. PARAMETERS lpi_num
  52.  
  53.    ** Use as: ??? LPI( lpi_number )
  54.    ** Defines /newline with
  55.  
  56.    line_size = STR(72/lpi_num,2,2)
  57.    ??? "/newline"
  58.    ??? "  {/ypos ypos &line_size sub def"
  59.    ??? "  0 xpos ypos moveto} def"
  60.  
  61. RETURN ''
  62.  
  63. * ---------------------------------------------------------
  64.  
  65. FUNCTION FontPick
  66. PARAMETERS _font_, _size_
  67.  
  68.    ** Use as: ??? FONTPICK(font_name, font_point_size)
  69.    ** Other fonts will be added later
  70.  
  71.    points = ALLTRIM(STR(_size_,5,1))
  72.  
  73.    DO CASE
  74.       CASE _font_ = "HEN"
  75.          _temp  = "/Helvetica findfont " + points + " scalefont setfont" + crlf
  76.       CASE _font_ = "HEO"
  77.          _temp  = "/Helvetica-Oblique findfont " + points + " scalefont setfont" + crlf
  78.       CASE _font_ = "HEB"
  79.          _temp  = "/Helvetica-Bold findfont " + points + " scalefont setfont" + crlf
  80.       CASE _font_ = "HEX"
  81.          _temp  = "/Helvetica-BoldOblique findfont " + points + " scalefont setfont" + crlf
  82.       CASE _font_ = "TRN"
  83.          _temp  = "/Times-Roman findfont " + points + " scalefont setfont" + crlf
  84.       CASE _font_ = "TRI"
  85.          _temp  = "/Times-Italic findfont " + points + " scalefont setfont" + crlf
  86.       CASE _font_ = "TRB"
  87.          _temp  = "/Times-Bold findfont " + points + " scalefont setfont" + crlf
  88.       CASE _font_ = "TRX"
  89.          _temp  = "/Times-BoldItalic findfont " + points + " scalefont setfont" + crlf
  90.       CASE _font_ = "CRN"
  91.          _temp  = "/Courier findfont " + points + " scalefont setfont" + crlf
  92.       CASE _font_ = "CRO"
  93.          _temp  = "/Courier-Oblique findfont " + points + " scalefont setfont" + crlf
  94.       CASE _font_ = "CRB"
  95.          _temp  = "/Courier-Bold findfont " + points + " scalefont setfont" + crlf
  96.       CASE _font_ = "CRX"
  97.          _temp  = "/Courier-BoldOblique findfont " + points + " scalefont setfont" + crlf
  98.       CASE _font_ = "AGN"
  99.          _temp  = "/AvantGarde-Book findfont " + points + " scalefont setfont" + crlf
  100.       CASE _font_ = "AGO"
  101.          _temp  = "/AvantGarde-BookOblique findfont " + points + " scalefont setfont" + crlf
  102.       CASE _font_ = "AGD"
  103.          _temp  = "/AvantGarde-Demi findfont " + points + " scalefont setfont" + crlf
  104.       CASE _font_ = "AGX"
  105.          _temp  = "/AvantGarde-DemiOblique findfont " + points + " scalefont setfont" + crlf
  106.       CASE _font_ = "BKL"
  107.          _temp  = "/Bookman-Light findfont " + points + " scalefont setfont" + crlf
  108.       CASE _font_ = "BKI"
  109.          _temp  = "/Bookman-LightItalic findfont " + points + " scalefont setfont" + crlf
  110.       CASE _font_ = "BKD"
  111.          _temp  = "/Bookman-Demi findfont " + points + " scalefont setfont" + crlf
  112.       CASE _font_ = "BKX"
  113.          _temp  = "/Bookman-DemiItalic findfont " + points + " scalefont setfont" + crlf
  114.       CASE _font_ = "HNN"
  115.          _temp  = "/Helvetica-Narrow findfont " + points + " scalefont setfont" + crlf
  116.       CASE _font_ = "HNO"
  117.          _temp  = "/Helvetica-Narrow-Oblique findfont " + points + " scalefont setfont" + crlf
  118.       CASE _font_ = "HNB"
  119.          _temp  = "/Helvetica-Narrow-Bold findfont " + points + " scalefont setfont" + crlf
  120.       CASE _font_ = "HNX"
  121.          _temp  = "/Helvetica-Narrow-BoldOblique findfont " + points + " scalefont setfont" + crlf
  122.       CASE _font_ = "NCN"
  123.          _temp  = "/NewCenturySchlbk-Roman findfont " + points + " scalefont setfont" + crlf
  124.       CASE _font_ = "NCI"
  125.          _temp  = "/NewCenturySchlbk-Italic findfont " + points + "  scalefont setfont" + crlf
  126.       CASE _font_ = "NCB"
  127.          _temp  = "/NewCenturySchlbk-Bold findfont " + points + "  scalefont setfont" + crlf
  128.       CASE _font_ = "NCX"
  129.          _temp  = "/NewCenturySchlbk-BoldItalic findfont " + points + "  scalefont setfont" + crlf
  130.       CASE _font_ = "PAN"
  131.          _temp  = "/Palatino-Roman findfont " + points + "  scalefont setfont" + crlf
  132.       CASE _font_ = "PAI"
  133.          _temp  = "/Palatino-Italic findfont " + points + "  scalefont setfont" + crlf
  134.       CASE _font_ = "PAB"
  135.          _temp  = "/Palatino-Bold findfont " + points + "  scalefont setfont" + crlf
  136.       CASE _font_ = "PAX"
  137.          _temp  = "/Palatino-BoldItalic findfont " + points + "  scalefont setfont" + crlf
  138.       CASE _font_ = "ZCM"
  139.          _temp  = "/ZapfChancery-MediumItalic findfont " + points + "  scalefont setfont" + crlf
  140.       CASE _font_ = "ZAD"
  141.          _temp  = "/ZapfDingbats findfont " + points + "  scalefont setfont" + crlf
  142.       CASE _font_ = "SYM"
  143.          _temp  = "/Symbol findfont " + points + "  scalefont setfont" + crlf
  144.       OTHERWISE
  145.          _temp  = ''
  146.    ENDCASE
  147.  
  148. RETURN _temp
  149.  
  150. * ---------------------------------------------------------
  151.  
  152. FUNCTION SayIt
  153. PARAMETERS _down , _over , _text, _pict
  154.  
  155.    ** Use as: ??? SayIt(inches_down, inches_over, info_print)
  156.    ** ALL non-character is now handled without prior conversion
  157.    ** Number data is RIGHT JUSTIFIED at _down, _over place
  158.  
  159.    _type = TYPE("_text")
  160.    DO CASE
  161.       CASE _type = "C" .OR. _type = "D" .OR. _type = "L"
  162.          DO CASE
  163.             CASE _type = "D"
  164.                _text = DTOC( _text )
  165.             CASE _type = "L"
  166.                IF _text
  167.                   _text = "Y"
  168.                ELSE
  169.                   _text = "N"
  170.                ENDIF
  171.          ENDCASE
  172.          _down   = ( _down - TMargin )*72
  173.          _over   = ( _over + LMargin )*72
  174.          mypos   = STR( _down, 4 )
  175.          mxpos   = STR( _over, 4 )
  176.          _temp   = mxpos + " " + mypos + " moveto" + crlf
  177.          _temp   = _temp + "(" + _text + ") show" + crlf
  178.       CASE _type = "N"
  179.          _temp = LTRIM(TRANSFORM( _text, _pict ))
  180.          _down   = ( _down - TMargin )*72
  181.          _over   = ( _over + LMargin )*72
  182.          mypos   = STR( _down, 4 )
  183.          mxpos   = STR( _over, 4 )
  184.          _temp   = "(" + _temp + ")" + " dup stringwidth pop"
  185.          _temp   =  _temp + " " +  mxpos + " exch sub"
  186.          _temp   =  _temp + " " +  mypos + " moveto show" + crlf
  187.       OTHERWISE
  188.          _temp = ''
  189.    ENDCASE
  190.  
  191.  
  192. RETURN _temp
  193.  
  194. * ---------------------------------------------------------
  195.  
  196. FUNCTION SetGray
  197. PARAMETERS _gray
  198.  
  199.    ** Use as ??? SETGRAY(percent_white)
  200.    ** 0 = Black, 1 = white, .01 - .99 = gray shades
  201.    ** This also impacts the fonts and line/box drawing
  202.  
  203.    gray_ = ALLTRIM(STR( _gray, 4,2 ))
  204.    _temp = gray_ + " setgray" + crlf
  205.  
  206. RETURN _temp
  207.  
  208. * ---------------------------------------------------------
  209.  
  210. FUNCTION LineDraw
  211. PARAMETERS _sline , _scol ,_eline , _ecol , _thick
  212.  
  213.    ** Use as: ??? LINEDRAW(start_line, start_column, end_line,
  214.    **                      end_column, thickness)
  215.    ** Line and column numbers are in inches
  216.    ** Thickness is times 1/72 inch
  217.  
  218.    sline_   = STR(( 72 * ( _sline - TMargin )) , 4 )
  219.    scol_    = STR(( 72 * ( _scol  + LMargin )) , 4 )
  220.    eline_   = STR(( 72 * ( _eline - TMargin )) , 4 )
  221.    ecol_    = STR(( 72 * ( _ecol  + LMargin )) , 4 )
  222.    thick_   = STR(  _thick  , 4 )
  223.  
  224.    _temp = "newpath" + crlf
  225.    _temp = _temp + "   " + scol_ + " " + sline_ + " moveto" + crlf
  226.    _temp = _temp + "   " + ecol_ + " " + eline_ + " lineto" + crlf
  227.    _temp = _temp + "   " + thick_  + " " + " setlinewidth" + crlf
  228.    _temp = _temp + "stroke" + crlf
  229.  
  230. RETURN _temp
  231.  
  232. * ---------------------------------------------------------
  233.  
  234. FUNCTION BoxDraw
  235. PARAMETERS _sline , _scol ,_width , _height , _thick
  236.  
  237.    ** Use as: ??? BOXDRAW(start_line, start_column, width, height, thickness)
  238.    ** Line, column, width and height numbers are in inches
  239.    ** Thickness is times 1/72 inch
  240.  
  241.    sline_   = STR(( 72 * ( _sline - TMargin )) , 4 )
  242.    scol_    = STR(( 72 * ( _scol  + LMargin )) , 4 )
  243.    width_   = STR(( 72 * ( _width  )) , 4 )
  244.    height_  = STR(( 72 * ( _height )) , 4 )
  245.    thick_   = STR(  _thick         , 4 )
  246.  
  247.    _temp = "newpath" + crlf
  248.    _temp = _temp + "   " + scol_ + " " + sline_ + " moveto" + crlf
  249.    _temp = _temp + "   " + RIGHT( width_, 4) + "    0" + " rlineto" + crlf
  250.    _temp = _temp + "   " + "   0 " + SPACE(4-LEN(ALLTRIM( height_ ))-1) + ;
  251.                        "-" + ALLTRIM(height_) + " rlineto" + crlf
  252.    _temp = _temp + "   " + SPACE(4-LEN(ALLTRIM( width_ ))-1) +"-"+ ;
  253.                        ALLTRIM( width_ ) + "    0 rlineto " + crlf
  254.    _temp = _temp + "   " + "closepath" + crlf
  255.    _temp = _temp + "   " + thick_ + " setlinewidth" + crlf
  256.    _temp = _temp + "stroke" + crlf
  257.  
  258. RETURN _temp
  259.  
  260. * ---------------------------------------------------------
  261.  
  262. FUNCTION BoxShade
  263. PARAMETERS _sline , _scol ,_width , _height , _gray
  264.  
  265.    ** Use as: ??? BOXSHADE(start_line, start_column, width, height,
  266.    **                      percent_gray)
  267.    ** Line, column, width and height numbers are in inches
  268.    ** Gray percent is based on white = 100% = 1.0, 50% = .50, etc.
  269.  
  270.    sline_   = STR(( 72 * ( _sline - TMargin )) , 4 )
  271.    scol_    = STR(( 72 * ( _scol  + LMargin )) , 4 )
  272.    width_   = STR(( 72 * ( _width  )) , 4 )
  273.    height_  = STR(( 72 * ( _height )) , 4 )
  274.    gray_    = STR(  _gray         , 4, 2 )
  275.  
  276.    _temp = "newpath" + crlf
  277.    _temp = _temp + "   gsave" + crlf
  278.    _temp = _temp + "   " + scol_ + " " + sline_ + " moveto" + crlf
  279.    _temp = _temp + "   " + RIGHT(width_,4) + "    0 rlineto" + crlf
  280.    _temp = _temp + "      0 " + SPACE(4-LEN(ALLTRIM(height_))-1) + "-"+ ;
  281.                        ALLTRIM(height_)  + " rlineto" + crlf
  282.    _temp = _temp + "   " + SPACE(4-LEN(ALLTRIM(width_))-1) + "-" + ;
  283.                        ALLTRIM(width_) + "    0 rlineto" + crlf
  284.    _temp = _temp + "   closepath" + crlf
  285.    _temp = _temp + "   " + gray_ + " setgray" + crlf
  286.    _temp = _temp + "   fill" + crlf
  287.    _temp = _temp + "   grestore" + crlf
  288.  
  289. RETURN _temp
  290.  
  291. * ---------------------------------------------------------
  292.  
  293. * EOF: PS_LIB.PRG
  294.